home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / UserCode / sortLines.tcl < prev    next >
Text File  |  1995-12-29  |  2KB  |  101 lines
  1. # FILE: sortLines.tcl
  2. #
  3. # LAST UPDATE: 1/26/93 4:53:48 PM
  4. #
  5. # This version of sortLines has the option of ignoring blanks/whitespace (-b)
  6. # and case-insensitive sorting (-i), or reverse sorting:
  7. #     sortLines [-b] [-i] [-r]
  8.  
  9. # COPYRIGHT:
  10. #
  11. #    Copyright ⌐ 1992,1993 by David C. Black All rights reserved.
  12. #    Portions copyright ⌐ 1990, 1991, 1992 Pete Keleher. All Rights Reserved.
  13. #
  14. #    Redistribution and use in source and binary forms are permitted
  15. #    provided that the above copyright notice and this paragraph are
  16. #    duplicated in all such forms and that any documentation,
  17. #    advertising materials, and other materials related to such
  18. #    distribution and use acknowledge that the software was developed
  19. #    by David C. Black.
  20. #
  21. #    THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
  22. #    IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  23. #    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  24. #
  25. ################################################################################
  26.  
  27. # AUTHOR
  28. #
  29. #    David C. Black
  30. #    GEnie:    D.C.Black
  31. #    Internet: black@mpd.tandem.com (preferred)
  32. #    USnail:   6217 John Chisum Lane, Austin, TX 78749
  33. #
  34. ################################################################################
  35.  
  36. proc reverseSort {} {sortLines -r}
  37.  
  38. proc sortLines {args} {
  39.     set b_flag [lsearch $args "-b"]
  40.     if {$b_flag != -1} {
  41.         set args [lreplace $args $b_flag $b_flag]
  42.     }
  43.     incr b_flag
  44.  
  45.     set i_flag [lsearch $args "-i"]
  46.     if {$i_flag != -1} {
  47.         set args [lreplace $args $i_flag $i_flag]
  48.     }
  49.     incr i_flag
  50.     
  51.     if {[lsearch $args "-r"] >= 0} {
  52.         set mode "-decreas"
  53.     } else {
  54.         set mode "-increas"
  55.     }
  56.     
  57.     set start [getPos]
  58.     set end  [selEnd]
  59.     if {$start == $end} {
  60.         alertnote "You must highlight the section you wish to sort."
  61.         return
  62.     }
  63.     if {[lookAt [expr $end-1]] != "\r"} {
  64.         alertnote "The selection must consist only of complete lines."
  65.         return
  66.     }
  67.     set text [split [getText $start [expr {$end-1}]] "\r"]
  68.     if {$b_flag > 0 || $i_flag > 0} {
  69.         foreach line $text {
  70.             if {$i_flag > 0} {
  71.                 set key [string tolower $line]
  72.             } else {
  73.                 set key $line
  74.             }
  75.             if {$b_flag > 0} {
  76.                 regsub -all "\[ \t\]+" $key " " key
  77.             }
  78.             set orig($key) $line
  79.             lappend list $key
  80.         }
  81.         #endforeach
  82.         unset text
  83.         foreach key [lsort $mode $list] {
  84.             lappend text $orig($key)
  85.         }
  86.         #endforeach
  87.     } else {
  88.         set text [lsort $mode $text]
  89.     }
  90.     set text [join $text "\r"]
  91.     replaceText $start [expr {$end-1}] $text
  92.     select $start $end
  93. }
  94.  
  95. # Test case:
  96. #
  97. # a  black
  98. # a black cat
  99. # A  black dog
  100.  
  101.